Attribute VB_Name = "modParsePacket"
Option Explicit

Public Type Packet_In
    PID1 As Byte
    PID2 As Byte
    LEN As Integer  ' signed, but data payload always less than 32768
    STATUS As Byte
    Data(32768) As Byte
    CheckSum As Long
End Type

Public ACK_Received As Boolean
Public ACK_Error As Byte
Public PacketIn(24648) As Byte ' largest possible IN packet
Public PIN As Packet_In

Public Enum ProcessRequestEnum
    preqProcessError = -1
    preqProcessNone = 0
    preqProcessStatus
    preqProcessStatusMX2
    preqProcessSpectrum
    preqProcessScopeData
    preqProcessTextData
    preqProcessScopeDataOverFlow
    preqProcessInetSettings
    preqProcessDiagData
    preqProcessHwDesc
    preqProcessCfgRead
    preqProcessNetFindRead
    preqProcessSCAData
    preqProcessAck
    preqProcessRequestPacket
    preqProcessTubeInterlockTableMX2
    preqProcessWarmupTableMX2
    preqProcessTimestampRecordMX2
    preqProcessFaultRecordMX2
End Enum

Public Type DppStateType
    Interface As CommType
    strPort As String
    ReqProcess As Long
    HaveScopeData As Boolean
    ScopeAutoRearm As Boolean
End Type

Public DppState As DppStateType

Public Sub ParsePacketStatus(ByRef P() As Byte, ByRef PIN As Packet_In)
    Dim x As Integer
    
    Dim CSum As Long
    CSum = 0
    If P(0) = SYNC1_ Then
        If P(1) = SYNC2_ Then
            If P(4) < 128 Then  ' LEN MSB < 128, i.e. LEN < 32768
                PIN.LEN = (P(4) * 256) + P(5)
                'PIN.LEN = TwoByteToLong(P(4), P(5))
                PIN.PID1 = P(2)
                PIN.PID2 = P(3)
                For x = 0 To PIN.LEN + 5    ' add up all the bytes except checksum
                    CSum = CSum + P(x)
                Next x
                CSum = CSum + 256 * CLng(P(PIN.LEN + 6)) + CLng(P(PIN.LEN + 7))
                PIN.CheckSum = CSum
                If (CSum And &HFFFF&) = 0 Then
                    PIN.STATUS = 0      ' packet is OK
                    If PIN.LEN > 0 Then
                        For x = 6 To 5 + PIN.LEN
                            PIN.Data(x - 6) = P(x)
                        Next x
                        ' call processing routines based on PID?
                    End If
                Else
                    PIN.STATUS = PID2_ACK_CHECKSUM_ERROR    ' checksum error
                End If
            Else
                PIN.STATUS = PID2_ACK_LEN_ERROR        ' length error
            End If
        Else
            PIN.STATUS = PID2_ACK_SYNC_ERROR            ' sync error
        End If
    Else
        PIN.STATUS = PID2_ACK_SYNC_ERROR                ' sync error
    End If
    '    Packet_Received = True  ' flag that packet was received, regardless of errors

End Sub

Public Function PID2_AckToString(strPacketSource As String, ByRef PID2 As Byte) As String
    PID2_AckToString = ""
    ACK_Error = PID2
    ACK_Received = False
    If ((PID2 >= PID2_ACK_OK) And (PID2 >= PID2_ACK_OK)) Then ACK_Received = True
    Select Case PID2
        Case PID2_ACK_OK    ' ACK OK
            PID2_AckToString = ""      'PID2_AckToString = strPacketSource & ": OK" & vbTab
        Case PID2_ACK_SYNC_ERROR
            PID2_AckToString = strPacketSource & ": Sync Error" & vbTab
        Case PID2_ACK_PID_ERROR
            PID2_AckToString = strPacketSource & ": PID Error" & vbTab
        Case PID2_ACK_LEN_ERROR
            PID2_AckToString = strPacketSource & ": Length Error" & vbTab
        Case PID2_ACK_CHECKSUM_ERROR
            PID2_AckToString = strPacketSource & ": Checksum Error" & vbTab
        Case PID2_ACK_BAD_PARAM
            PID2_AckToString = strPacketSource & ": Bad Parameter" & vbTab  'TextLog "ACK: BAD PARAM '" + T$ + "'" + vbCrLf
        Case PID2_ACK_BAD_HEX_REC
            PID2_AckToString = strPacketSource & ": Bad HEX Record" & vbTab
        Case PID2_ACK_UNRECOG   '>>>>>>> Decode Command for diagnositcs <<<<<<<
            PID2_AckToString = strPacketSource & ": Unrecognized Command" & vbTab
        Case PID2_ACK_FPGA_ERROR
            PID2_AckToString = strPacketSource & ": FPGA error (not initialized)" & vbTab
        Case PID2_ACK_CP2201_NOT_FOUND
            PID2_AckToString = strPacketSource & ": CP2201 not found" & vbTab
        Case PID2_ACK_SCOPE_DATA_NOT_AVAIL
            PID2_AckToString = strPacketSource & ": Scope data not available" & vbTab
        Case PID2_ACK_PC5_NOT_PRESENT
            PID2_AckToString = strPacketSource & ": PC5 not present" & vbTab
        Case PID2_ACK_OK_ETHERNET_SHARE_REQ
            PID2_AckToString = strPacketSource & ": ACK OK Interface sharing request " & vbTab
        Case PID2_ACK_ETHERNET_BUSY
            PID2_AckToString = strPacketSource & ": Busy another interface is in use" & vbTab
        Case PID2_ACK_I2C_ERROR
            PID2_AckToString = strPacketSource & ": I2C error" & vbTab
        Case PID2_ACK_OK_FPGA_ADDRESS
            PID2_AckToString = strPacketSource & ": ACK OK FPGA upload address" & vbTab
        Case PID2_ACK_NO_FPGA_SUPPORT
            PID2_AckToString = strPacketSource & ": Feature not supported by this FPGA version" & vbTab
        Case PID2_ACK_NO_CALIBRATION_DATA
            PID2_AckToString = strPacketSource & ": Calibration data not present" & vbTab
    End Select
End Function

Public Function isRequestPacket(PIN As Packet_In) As Boolean
    isRequestPacket = False
    Select Case PIN.PID1
        Case PID1_REQ_STATUS:       '&H1
            isRequestPacket = True
        Case PID1_REQ_SPECTRUM:     '&H2
            isRequestPacket = True
        Case PID1_REQ_SCOPE_MISC:   '&H3
            isRequestPacket = True
        Case PID1_REQ_SCA:          '&H4
            isRequestPacket = True
        Case PID1_REQ_CONFIG:       '&H20
            isRequestPacket = True
        Case PID1_REQ_FPGA_UC:      '&H30
            isRequestPacket = True
        Case PID1_VENDOR_REQ:       '&HF0
            isRequestPacket = True
        Case PID1_COMM_TEST:        '&HF1
            isRequestPacket = True
    End Select
End Function

Public Function ParsePacket(ByRef P() As Byte, ByRef PIN As Packet_In) As Long
    ParsePacket = preqProcessNone
    ParsePacketStatus P, PIN
    If (PIN.STATUS = PID2_ACK_OK) Then ' no errors
        If (isRequestPacket(PIN)) Then
            ParsePacket = preqProcessRequestPacket
        ElseIf ((PIN.PID1 = PID1_RCV_STATUS) And (PIN.PID2 = RCVPT_DPP_STATUS)) Then 'status
            ParsePacket = preqProcessStatus
        ElseIf ((PIN.PID1 = PID1_RCV_STATUS) And (PIN.PID2 = RCVPT_MX2_STATUS)) Then 'Mini-X2 status
            ParsePacket = preqProcessStatusMX2
        ElseIf ((PIN.PID1 = PID1_RCV_SPECTRUM) And ((PIN.PID2 >= RCVPT_256_CHANNEL_SPECTRUM) And (PIN.PID2 <= RCVPT_8192_CHANNEL_SPECTRUM_STATUS))) Then ' spectrum / spectrum+status
            ParsePacket = preqProcessSpectrum
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_512_BYTE_MISC_DATA)) Then 'text data packet
            ParsePacket = preqProcessTextData
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_CONFIG_READBACK)) Then
            ParsePacket = preqProcessCfgRead
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_NETFINDER_READBACK)) Then
            ParsePacket = preqProcessNetFindRead
'---------------------------------------------------------------------------------- Start Mini-X2
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_MX2_TUBE_ILOCK_TABLE)) Then
            ParsePacket = preqProcessTubeInterlockTableMX2
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_MX2_WARMUP_TABLE)) Then
            ParsePacket = preqProcessWarmupTableMX2
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_MX2_TIMESTAMP_RECORD)) Then
            ParsePacket = preqProcessTimestampRecordMX2
        ElseIf ((PIN.PID1 = PID1_RCV_SCOPE_MISC) And (PIN.PID2 = RCVPT_MX2_FAULT_RECORD)) Then
            ParsePacket = preqProcessFaultRecordMX2
'---------------------------------------------------------------------------------- End Mini-X2
        ElseIf ((PIN.PID1 = PID1_RCV_SCA) And (PIN.PID2 = RCVPT_SCA)) Then
            ParsePacket = preqProcessSCAData
        ElseIf (PIN.PID1 = PID1_ACK) Then
            ParsePacket = preqProcessAck
        Else
            PIN.STATUS = PID2_ACK_PID_ERROR  ' unknown PID
            ParsePacket = preqProcessError
        End If
    Else
        ParsePacket = preqProcessError
    End If

    'PIN.PID1 = 0    ' overwrite the PIDs so packet can't be erroneously processed again
    'PIN.PID2 = 0

End Function

Public Function ParsePacketToString(PIN As Packet_In, DppState As DppStateType) As String
    Select Case DppState.ReqProcess
        Case preqProcessStatus
            ParsePacketToString = "Status Response"
        Case preqProcessStatusMX2
            ParsePacketToString = "Mini-X2 Status Response"
        Case preqProcessSpectrum
            ParsePacketToString = "Spectrum Data "
        Case preqProcessCfgRead
            ParsePacketToString = "Configuration Readback " & CfgBytesToString(PIN)
            ParsePacketToString = "Ack " & CStr(PIN.PID2)
        Case preqProcessError
            ParsePacketToString = "Packet Error"
        '------------------------------------------------------ Mini-X2 Functions
        Case preqProcessTubeInterlockTableMX2
            ParsePacketToString = "Mini-X2 Tube and Interlock Table"
        Case preqProcessWarmupTableMX2
            ParsePacketToString = "Mini-X2 Warmup Table"
        Case preqProcessTimestampRecordMX2
            ParsePacketToString = "Mini-X2 Timestamp Record"
        Case preqProcessFaultRecordMX2
            ParsePacketToString = "Mini-X2 Fault Record"
        '------------------------------------------------------ Request Functions
        Case preqProcessRequestPacket
            ParsePacketToString = DecodeRequestPacket(PIN)
        Case Else
            ParsePacketToString = "Unknown -> do nothing"
    End Select
End Function

'convert a 4 byte long word to a double
'lwStart - starting index of longword
'buffer - byte buffer
Private Function LongWordToDouble(lwStart As Long, Buffer() As Byte) As Double
    Dim dblVal As Double
    Dim idxByte As Long
    Dim ByteMask As Double
    dblVal = 0
    For idxByte = 0 To 3      ' build 4 bytes (lwStart-lwStart+3) into double
        ByteMask = 2 ^ (8 * idxByte)
        dblVal = dblVal + (Buffer((lwStart + idxByte)) * ByteMask)
    Next
    LongWordToDouble = dblVal
End Function

Public Sub Process_Status(STATUS As Stat)
    Dim bDMCA_LiveTime As Boolean
    Dim uiFwBuild As Long
    isMiniX2 = False
    uiFwBuild = 0
    bDMCA_LiveTime = False
    STATUS.DEVICE_ID = STATUS.RAW(39)       '0=dp5,1=px5,2=dp5g,3=mca8000d,4=tb5
    Select Case STATUS.DEVICE_ID
        Case 0
            STATUS.strDeviceID = "DP5"
        Case 1
            STATUS.strDeviceID = "PX5"
        Case 2
            STATUS.strDeviceID = "DP5G"
        Case 3
            STATUS.strDeviceID = "MCA8000D"
        Case 4
            STATUS.strDeviceID = "TB5"
        Case 5
            STATUS.strDeviceID = "DP5-X"
        Case Else
            STATUS.strDeviceID = "DP5" 'default
    End Select

    STATUS.FastCount = LongWordToDouble(0, STATUS.RAW)
    STATUS.SlowCount = LongWordToDouble(4, STATUS.RAW)
    STATUS.GP_COUNTER = LongWordToDouble(8, STATUS.RAW)
    STATUS.AccumulationTime = STATUS.RAW(12) * 0.001 + (STATUS.RAW(13) + STATUS.RAW(14) * 256# + STATUS.RAW(15) * 65536#) * 0.1
    STATUS.RealTime = LongWordToDouble(20, STATUS.RAW) * 0.001

    STATUS.Firmware = STATUS.RAW(24)
    STATUS.FPGA = STATUS.RAW(25)
    
    If (STATUS.Firmware > &H65) Then
        STATUS.Build = STATUS.RAW(37) And &HF   ' Build # added in FW6.06
    Else
        STATUS.Build = 0
    End If

    'Firmware Version:  6.07  Build:  0 has LiveTime and PREL
    'DEVICE_ID 0=DP5,1=PX5,2=DP5G,3=MCA8000D,4=TB5
    If (STATUS.DEVICE_ID = dppMCA8000D) Then
        If (STATUS.Firmware >= &H67) Then
            bDMCA_LiveTime = True
        End If
    End If

    If (bDMCA_LiveTime) Then
        STATUS.LiveTime = LongWordToDouble(16, STATUS.RAW) * 0.001
    Else
        STATUS.LiveTime = 0
    End If

    If (STATUS.RAW(29) < 128) Then
        STATUS.SerialNumber = CLng(LongWordToDouble(26, STATUS.RAW))
    Else
        STATUS.SerialNumber = -1
    End If

    If (STATUS.RAW(30) < 128) Then    ' not negative
        STATUS.HV = CDbl(STATUS.RAW(31) + (STATUS.RAW(30) * 256#)) * 0.5  ' 0.5V/count
    Else
        STATUS.HV = CDbl((STATUS.RAW(31) + (STATUS.RAW(30) * 256#)) - 65536#) * 0.5   ' 0.5V/count
    End If
    
    STATUS.DET_TEMP = CSng(STATUS.RAW(33) + (STATUS.RAW(32) And 15) * 256) * 0.1 - 273.16 ' 0.1K/count
    STATUS.DP5_TEMP = STATUS.RAW(34) - ((STATUS.RAW(34) And 128) * 2)

    STATUS.PresetRtDone = ((STATUS.RAW(35) And 128) = 128)

    'BYTE:35 BIT:D6
    ' = Preset LiveTime Done for MCA8000D
    ' = FAST Thresh locked for other dpp devices
    STATUS.PresetLtDone = False
    STATUS.AFAST_LOCKED = False
    If (bDMCA_LiveTime) Then       ' test for MCA8000D
        STATUS.PresetLtDone = ((STATUS.RAW(35) And 64) = 64)
    Else
        STATUS.AFAST_LOCKED = ((STATUS.RAW(35) And 64) = 64)
    End If
    STATUS.MCA_EN = ((STATUS.RAW(35) And 32) = 32)
    STATUS.PresetCountDone = ((STATUS.RAW(35) And 16) = 16)
    STATUS.SCOPE_DR = ((STATUS.RAW(35) And 4) = 4)
    STATUS.DP5_CONFIGURED = ((STATUS.RAW(35) And 2) = 2)

    STATUS.AOFFSET_LOCKED = ((STATUS.RAW(36) And 128) = 0)  ' 0=locked, 1=searching
    STATUS.MCS_DONE = ((STATUS.RAW(36) And 64) = 64)

    STATUS.b80MHzMode = ((STATUS.RAW(36) And 2) = 2)
    STATUS.bFPGAAutoClock = ((STATUS.RAW(36) And 1) = 1)

    STATUS.PC5_PRESENT = ((STATUS.RAW(38) And 128) = 128)
    If (STATUS.PC5_PRESENT) Then
        STATUS.PC5_HV_POL = ((STATUS.RAW(38) And 64) = 64)
        STATUS.PC5_8_5V = ((STATUS.RAW(38) And 32) = 32)
    Else
        STATUS.PC5_HV_POL = False
        STATUS.PC5_8_5V = False
    End If

    If (STATUS.Firmware >= &H65) Then   ' reboot flag added FW6.05
        If ((STATUS.RAW(36) And 32) = 32) Then
            STATUS.ReBootFlag = True
        Else
            STATUS.ReBootFlag = False
        End If
    Else
        STATUS.ReBootFlag = False
    End If

    STATUS.TEC_Voltage = ((CDbl(STATUS.RAW(40) And 15) * 256#) + CDbl(STATUS.RAW(41))) / 758.5
    STATUS.DPP_ECO = STATUS.RAW(49)
    STATUS.bScintHas80MHzOption = False
    STATUS.DPP_options = (STATUS.RAW(42) And 15)
    STATUS.HPGe_HV_INH = False
    STATUS.HPGe_HV_INH_POL = False
    STATUS.AU34_2 = False
    STATUS.isAscInstalled = False
    STATUS.isDP5_RevDxGains = False
    If (STATUS.DEVICE_ID = dppPX5) Then
        If (STATUS.DPP_options = PX5_OPTION_HPGe_HVPS) Then
            STATUS.HPGe_HV_INH = ((STATUS.RAW(42) And 32) = 32)
            STATUS.HPGe_HV_INH_POL = ((STATUS.RAW(42) And 16) = 16)
            If (STATUS.DPP_ECO = 1) Then
                STATUS.isAscInstalled = True
                STATUS.AU34_2 = ((STATUS.RAW(42) And 64) = 64)
            End If
        End If
     ElseIf ((STATUS.DEVICE_ID = dppDP5G) Or (STATUS.DEVICE_ID = dppTB5)) Then
        If ((STATUS.DPP_ECO = 1) Or (STATUS.DPP_ECO = 2)) Then
            STATUS.bScintHas80MHzOption = True
        End If
        
    ElseIf (STATUS.DEVICE_ID = dppDP5) Then
        uiFwBuild = STATUS.Firmware
        uiFwBuild = uiFwBuild * CLng(256)   '  << 8
        uiFwBuild = uiFwBuild + STATUS.Build
        ' uiFwBuild - firmware with build for comparison
        uiFwBuild = uiFwBuild And &HFFFF
        If (uiFwBuild >= &H686) Then
            ' 0xFF Value indicates old Analog Gain Count of 16
            ' Values < 0xFF indicate new gain count of 24 and new board rev
            ' "DP5 G3 Configuration P" will not be used (==&HFF)
            If (STATUS.DPP_ECO < &HFF) Then
                STATUS.isDP5_RevDxGains = True
            End If
        End If
    End If
    
'    MsgBox DP5_Dx_OptionFlags(STATUS.DPP_ECO)

End Sub

'DP5 Revision and Configuration from ECO Byte
'   D7-D6: 0-4, = DP5 Rev D-G
'   D5-D4: minor rev, 0-3 (i.e. Rev D0, D1 etc.)
'   D3-D0: Configuration 0 = A, 1=B, 2=C... 15=P.
Public Function DP5_Dx_OptionFlags(DP5_Dx_Options As Byte) As String
    Dim strRev As String
    strRev = "Reported Rev/Config: "
    strRev = strRev & Chr(((DP5_Dx_Options \ 64) And &H3) + Asc("D"))       'D7D6
    strRev = strRev & Chr((DP5_Dx_Options And &H30) \ 16 + Asc("0")) + "-"  'D5D4
    strRev = strRev & Chr((DP5_Dx_Options And 15) + Asc("A"))               'D3D0
    DP5_Dx_OptionFlags = strRev
End Function

Public Function FmtHex(ByVal DecNum As Long, ByVal HexDig As Long) As String
    Dim strHex As String
    Dim lHex As Long

    strHex = Hex(DecNum)
    lHex = Len(strHex)
    If (lHex < HexDig) Then
        FmtHex = String(HexDig - lHex, "0") + strHex
    Else
        FmtHex = strHex
    End If
End Function

Public Function VersionToStr(bVersion As Byte) As String
    VersionToStr = Trim(Str((bVersion And &HF0) / 16)) + "." + Format((bVersion And &HF), "00")
End Function

Public Function OnOffStr(bOnOff As Boolean) As String
    If (bOnOff) Then
        OnOffStr = "ON"
    Else
        OnOffStr = "OFF"
    End If
End Function

Public Function IsAorB(bIsA As Boolean, strA As String, strB As String) As String
    If (bIsA) Then
        IsAorB = strA
    Else
        IsAorB = strB
    End If
End Function
